home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1999 January / PC Plus Super CD No55a (PCP-147A-1-99) (Disc 1) (1998).iso / linux / developers / visualtcl / windows / vtcl / lib / propmgr.tcl < prev    next >
Encoding:
Text File  |  1997-09-14  |  12.4 KB  |  365 lines
  1. ##############################################################################
  2. # $Id: propmgr.tcl,v 1.12 1997/09/14 21:08:30 stewart Exp $
  3. #
  4. # propmgr.tcl - procedures used by the widget properites manager
  5. #
  6. # Copyright (C) 1996-1997 Stewart Allen
  7. #
  8. # This program is free software; you can redistribute it and/or
  9. # modify it under the terms of the GNU General Public License
  10. # as published by the Free Software Foundation; either version 2
  11. # of the License, or (at your option) any later version.
  12. #
  13. # This program is distributed in the hope that it will be useful,
  14. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. # GNU General Public License for more details.
  17. #
  18. # You should have received a copy of the GNU General Public License
  19. # along with this program; if not, write to the Free Software
  20. # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. ##############################################################################
  23. #
  24.  
  25. proc vTcl:show_propmgr {} {
  26.     vTclWindow.vTcl.ae
  27. }
  28.  
  29. proc vTcl:grid:height {parent {col 0}} {
  30.     update idletasks
  31.     set h 0
  32.     set s [grid slaves $parent -column $col]
  33.     foreach i $s {
  34.         incr h [winfo height $i]
  35.     }
  36.     return $h
  37. }
  38.  
  39. proc vTcl:grid:width {parent {row 0}} {
  40.     update idletasks
  41.     set w 0
  42.     set s [grid slaves $parent -row $row]
  43.     foreach i $s {
  44.         incr w [winfo width $i]
  45.     }
  46.     return $w
  47. }
  48.  
  49. proc vTcl:prop:set_visible {which {on ""}} {
  50.     global vTcl
  51.     set var ${which}_on
  52.     switch $which {
  53.         info {
  54.             set f $vTcl(gui,ae).c.f1
  55.             set name "Widget"
  56.         }
  57.         attr {
  58.             set f $vTcl(gui,ae).c.f2
  59.             set name "Attributes"
  60.         }
  61.         geom {
  62.             set f $vTcl(gui,ae).c.f3
  63.             set name "Geometry"
  64.         }
  65.         default {
  66.             return
  67.         }
  68.     }
  69.     if {$on == ""} {
  70.         set on [expr - $vTcl(pr,$var)]
  71.     }
  72.     if {$on == 1} {
  73.         pack $f.f -side top -expand 1 -fill both
  74.         $f.l conf -text "$name (-)"
  75.         set vTcl(pr,$var) 1
  76.     } else {
  77.         pack forget $f.f
  78.         $f.l conf -text "$name (+)"
  79.         set vTcl(pr,$var) -1
  80.     }
  81.     update idletasks
  82.     vTcl:prop:recalc_canvas
  83. }
  84.  
  85. proc vTclWindow.vTcl.ae {args} {
  86.     global vTcl tcl_platform
  87.  
  88.     set ae $vTcl(gui,ae)
  89.     if {[winfo exists $ae]} {wm deiconify $ae; return}
  90.     toplevel $ae -class vTcl
  91.     wm withdraw $ae
  92.     wm transient $ae .vTcl
  93.     wm title $ae "Attribute Editor"
  94.     wm geometry $ae 206x325
  95.     wm resizable $ae 1 1
  96.     wm transient $vTcl(gui,ae) .vTcl
  97.  
  98.     canvas $ae.c -yscrollcommand "$ae.sv set" \
  99.         -xscrollcommand "$ae.sh set" -highlightthickness 0
  100.     scrollbar $ae.sh -orient horiz -command "$ae.c xview" -takefocus 0
  101.     scrollbar $ae.sv -orient vert  -command "$ae.c yview" -takefocus 0
  102.  
  103.     button $ae.b -command "wm withdraw $ae" -text "Done"
  104.  
  105.     grid $ae.c  -column 0 -row 0 -sticky news
  106.     grid $ae.sh -column 0 -row 1 -sticky ew
  107.     grid $ae.sv -column 1 -row 0 -sticky ns
  108.     grid $ae.b  -column 0 -row 2 -columnspan 2 -sticky news
  109.  
  110.     grid columnconf $ae 0 -weight 1
  111.     grid rowconf    $ae 0 -weight 1
  112.  
  113.     set f1 $ae.c.f1; frame $f1       ; # Widget Info
  114.         $ae.c create window 0 0 -window $f1 -anchor nw -tag info
  115.     set f2 $ae.c.f2; frame $f2       ; # Widget Attributes
  116.         $ae.c create window 0 0 -window $f2 -anchor nw -tag attr
  117.     set f3 $ae.c.f3; frame $f3       ; # Widget Geometry
  118.         $ae.c create window 0 0 -window $f3 -anchor nw -tag geom
  119.  
  120.     label $f1.l -text "Widget"     -relief raised -bg #aaaaaa -bd 1 -width 30
  121.         pack $f1.l -side top -fill x
  122.     label $f2.l -text "Attributes" -relief raised -bg #aaaaaa -bd 1 -width 30
  123.         pack $f2.l -side top -fill x
  124.     label $f3.l -text "Geometry"   -relief raised -bg #aaaaaa -bd 1 -width 30
  125.         pack $f3.l -side top -fill x
  126.  
  127.     bind $f1.l <ButtonPress> {vTcl:prop:set_visible info}
  128.     bind $f2.l <ButtonPress> {vTcl:prop:set_visible attr}
  129.     bind $f3.l <ButtonPress> {vTcl:prop:set_visible geom}
  130.  
  131.     set w $f1.f
  132.     frame $w; pack $w -side top -expand 1 -fill both
  133.  
  134.     label $w.ln -text "Widget" -width 11 -anchor w
  135.         entry $w.en -width 12 -textvariable vTcl(w,widget) \
  136.         -relief sunken -bd 1 -state disabled
  137.     label $w.lc -text "Class"  -width 11 -anchor w
  138.         entry $w.ec -width 12 -textvariable vTcl(w,class) \
  139.         -relief sunken -bd 1 -state disabled
  140.     label $w.lm -text "Manager" -width 11 -anchor w
  141.         entry $w.em -width 12 -textvariable vTcl(w,manager) \
  142.         -relief sunken -bd 1 -state disabled
  143.     label $w.la -text "Alias"  -width 11 -anchor w
  144.         entry $w.ea -width 12 -textvariable vTcl(w,alias) \
  145.         -relief sunken -bd 1 -state disabled
  146.     label $w.li -text "Insert Point" -width 11 -anchor w
  147.         entry $w.ei -width 12 -textvariable vTcl(w,insert) \
  148.         -relief sunken -bd 1 -state disabled
  149.  
  150.     grid columnconf $w 1 -weight 1
  151.  
  152.     grid $w.ln $w.en -padx 0 -pady 1 -sticky news
  153.     grid $w.lc $w.ec -padx 0 -pady 1 -sticky news
  154.     grid $w.lm $w.em -padx 0 -pady 1 -sticky news
  155.     grid $w.la $w.ea -padx 0 -pady 1 -sticky news
  156.     grid $w.li $w.ei -padx 0 -pady 1 -sticky news
  157.  
  158.     set w $f2.f
  159.     frame $w; pack $w -side top -expand 1 -fill both
  160.  
  161.     set w $f3.f
  162.     frame $w; pack $w -side top -expand 1 -fill both
  163.  
  164.     vTcl:prop:set_visible info $vTcl(pr,info_on)
  165.     vTcl:prop:set_visible attr $vTcl(pr,attr_on)
  166.     vTcl:prop:set_visible geom $vTcl(pr,geom_on)
  167.  
  168.     if { $vTcl(w,widget) != "" } {
  169.         vTcl:prop:update_attr
  170.     }
  171.     vTcl:setup_vTcl:bind $vTcl(gui,ae)
  172.     if {$tcl_platform(platform) == "macintosh"} {
  173.         set w [expr [winfo vrootwidth .] - 206]
  174.         wm geometry $vTcl(gui,ae) 200x300+$w+20
  175.     }
  176.     catch {wm geometry .vTcl.ae $vTcl(geometry,.vTcl.ae)}
  177.     update idletasks
  178.     vTcl:prop:recalc_canvas
  179.  
  180.     wm deiconify $ae
  181. }
  182.  
  183. proc vTcl:prop:recalc_canvas {} {
  184.     global vTcl
  185.     set ae $vTcl(gui,ae)
  186.     if {![winfo exists $ae]} {return}
  187.  
  188.     set f1 $ae.c.f1                              ; # Widget Info Frame
  189.     set f2 $ae.c.f2                              ; # Widget Attribute Frame
  190.     set f3 $ae.c.f3                              ; # Widget Geometry Frame
  191.  
  192.     $ae.c coords attr 0 [winfo height $f1]
  193.     $ae.c coords geom 0 [expr [winfo height $f1] + [winfo height $f2]]
  194.  
  195.     set w [vTcl:util:greatest_of "[winfo width $f1] \
  196.                                   [winfo width $f2] \
  197.                                   [winfo width $f3]" ]
  198.     set h [expr [winfo height $f1] + \
  199.                 [winfo height $f2] + \
  200.                 [winfo height $f3] ]
  201.     $ae.c configure -scrollregion "0 0 $w $h"
  202.     wm minsize .vTcl.ae $w 200
  203. }
  204.  
  205. proc vTcl:prop:update_attr {} {
  206.     global vTcl
  207.     if {$vTcl(var_update) == "no"} {
  208.         return
  209.     }
  210.  
  211.     #
  212.     # Update Widget Attributes
  213.     #
  214.     set fr $vTcl(gui,ae).c.f2.f
  215.     set top $fr._$vTcl(w,class)
  216.     update idletasks
  217.     if {[winfo exists $top]} {
  218.         if {$vTcl(w,class) != $vTcl(w,last_class)} {
  219.             catch {pack forget $fr._$vTcl(w,last_class)}
  220.             pack $top -side left -fill both -expand 1
  221.         }
  222.         foreach i $vTcl(opt,list) {
  223.             if {[lsearch $vTcl(w,optlist) $i] >= 0} {
  224.                 if { [lindex $vTcl(opt,$i) 2] == "color" } {
  225.                     $top.t${i}.f configure -bg $vTcl(w,opt,$i)
  226.                 }
  227.             }
  228.         }
  229.     } elseif [winfo exists $fr] {
  230.         catch {pack forget $fr._$vTcl(w,last_class)}
  231.         frame $top
  232.         pack $top -side top -expand 1 -fill both
  233.         grid columnconf $top 1 -weight 1
  234.         set type ""
  235.         foreach i $vTcl(opt,list) {
  236.             set newtype [lindex $vTcl(opt,$i) 1]
  237.             if {$type != $newtype} {
  238.                 set type $newtype
  239.             }
  240.             if {[lsearch $vTcl(w,optlist) $i] >= 0} {
  241.                 set variable "vTcl(w,opt,$i)"
  242.                 set config_cmd "\$vTcl(w,widget) configure $i \$$variable; "
  243.                 append config_cmd "vTcl:place_handles \$vTcl(w,widget)"
  244.                 vTcl:prop:new_attr $top $i $variable $config_cmd opt
  245.             }
  246.         }
  247.     }
  248.  
  249.     if {$vTcl(w,manager) == ""} {
  250.         update idletasks
  251.         vTcl:prop:recalc_canvas
  252.         return
  253.     }
  254.  
  255.     #
  256.     # Update Widget Geometry
  257.     #
  258.     set fr $vTcl(gui,ae).c.f3.f
  259.     set top $fr._$vTcl(w,manager)
  260.     set mgr $vTcl(w,manager)
  261.     update idletasks
  262.     if {[winfo exists $top]} {
  263.         if {$vTcl(w,manager) != $vTcl(w,last_manager)} {
  264.             catch {pack forget $fr._$vTcl(w,last_manager)}
  265.             pack $top -side left -fill both -expand 1
  266.         }
  267.     } elseif [winfo exists $fr] {
  268.         catch {pack forget $fr._$vTcl(w,last_manager)}
  269.         frame $top
  270.         pack $top -side top -expand 1 -fill both
  271.         grid columnconf $top 1 -weight 1
  272.         foreach i "$vTcl(m,$mgr,list) $vTcl(m,$mgr,extlist)" {
  273.             set variable "vTcl(w,$mgr,$i)"
  274.             set cmd [lindex $vTcl(m,$mgr,$i) 4]
  275.             set config_cmd "$cmd \$vTcl(w,widget) $i \$$variable"
  276.             if {$cmd == ""} {
  277.                 set config_cmd "$mgr conf \$vTcl(w,widget) $i \$$variable"
  278.             }
  279.             append config_cmd ";vTcl:place_handles \$vTcl(w,widget)"
  280.             vTcl:prop:new_attr $top $i $variable $config_cmd m,$mgr
  281.         }
  282.     }
  283.  
  284.     update idletasks
  285.     vTcl:prop:recalc_canvas
  286. }
  287.  
  288. proc vTcl:prop:new_attr {top option variable config_cmd prefix} {
  289.     global vTcl
  290.     set base $top.t${option}
  291.     label $top.$option \
  292.         -text "[lindex $vTcl($prefix,$option) 0]" -anchor w -width 11 -fg black
  293.     switch [lindex $vTcl($prefix,$option) 2] {
  294.         boolean {
  295.             frame $base
  296.             radiobutton ${base}.y \
  297.                 -variable $variable -value 1 -text "Yes" -relief sunken -bd 1 \
  298.                 -command "$config_cmd" -selectcolor #0077ff -padx 0 -pady 1
  299.             radiobutton ${base}.n \
  300.                 -variable $variable -value 0 -text "No" -relief sunken -bd 1 \
  301.                 -command "$config_cmd" -selectcolor #0077ff -padx 0 -pady 1
  302.             pack ${base}.y ${base}.n -side left -expand 1 -fill both
  303.         }
  304.         choice {
  305.             frame $base
  306.             menubutton ${base}.l \
  307.                 -textvariable $variable -bd 1 -width 12 -menu ${base}.l.m \
  308.                 -highlightthickness 1 -relief sunken -anchor w -fg black \
  309.                 -padx 0 -pady 1
  310.             menu ${base}.l.m -tearoff 0
  311.             foreach i [lindex $vTcl($prefix,$option) 3] {
  312.                 ${base}.l.m add command -label "$i" -command \
  313.                     "set $variable $i; $config_cmd; "
  314.             }
  315.             button ${base}.f -relief raised -bd 1 -image file_down \
  316.                 -height 5 -command "tkMbPost ${base}.l"
  317.             pack ${base}.l -side left -expand 1 -fill x
  318.             pack ${base}.f -side right -fill y -pady 1 -padx 1
  319.         }
  320.         menu {
  321.             button $base \
  322.                 -text "<click to edit>" -relief sunken -bd 1 -width 12 \
  323.                 -highlightthickness 1 -fg black -padx 0 -pady 1 \
  324.                 -command {
  325.                     vTcl:edit_target_menu $vTcl(w,widget)
  326.                 } -anchor w
  327.         }
  328.         color {
  329.             frame $base
  330.             entry ${base}.l -relief sunken -bd 1 \
  331.                 -textvariable $variable -width 8 \
  332.                 -highlightthickness 1 -fg black
  333.             bind ${base}.l <KeyRelease-Return> \
  334.                 "$config_cmd; ${base}.f conf -bg \$$variable"
  335.             frame ${base}.f -relief raised -bd 1 \
  336.                 -bg [subst $$variable] -width 20 -height 5
  337.             bind ${base}.f <ButtonPress> \
  338.                 "vTcl:show_color $top.t${option}.f $option $variable"
  339.             pack ${base}.l -side left -expand 1 -fill x
  340.             pack ${base}.f -side right -fill y -pady 1 -padx 1
  341.         }
  342.         command {
  343.             frame $base
  344.             entry ${base}.l -relief sunken -bd 1 \
  345.                 -textvariable $variable -width 8 \
  346.                 -highlightthickness 1 -fg black
  347.             bind ${base}.l <KeyRelease-Return> $config_cmd
  348.             button ${base}.f \
  349.                 -image ellipses -bd 1 -width 12 \
  350.                 -highlightthickness 1 -fg black -padx 0 -pady 1 \
  351.                 -command "vTcl:set_command \$vTcl(w,widget) $option"
  352.             pack ${base}.l -side left -expand 1 -fill x
  353.             pack ${base}.f -side right -fill y -pady 1 -padx 1
  354.         }
  355.         default {
  356.             entry $base \
  357.                 -textvariable $variable -relief sunken -bd 1 -width 12 \
  358.                 -highlightthickness 1 -fg black
  359.         }
  360.     }
  361.     bind $base <KeyRelease-Return> $config_cmd
  362.     grid $top.$option $base -sticky news
  363. }
  364.  
  365.